home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
TSR
/
TSRSRC35
/
MARKNET.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-10-21
|
21KB
|
738 lines
{**************************************************************************
* MARKNET - stores system information in a file for later restoration. *
* Copyright (c) 1986,1993 Kim Kokkonen, TurboPower Software. *
* May be freely distributed and used but not sold except by permission. *
***************************************************************************
* Version 2.7 3/4/89 *
* first public release *
* (based on FMARK 2.6) *
* Version 2.8 3/10/89 *
* store the DOS environment *
* store information about the async ports *
* Version 2.9 5/4/89 *
* for consistency *
* Version 3.0 7/21/91 *
* for compatibility with DOS 5 *
* add Quiet option *
* save BIOS LPT port data areas *
* save XMS allocation *
* add code for tracking high memory *
* Version 3.1 11/4/91 *
* no change *
* Version 3.2 11/22/91 *
* change method of accessing high memory *
* store parent's length as well as segment *
* Version 3.3 1/8/92 *
* new features for parsing and getting command line options *
* Version 3.4 2/14/92 *
* increase heap space to allow bigger FILES= *
* improve error reporting when out of heap space *
* store HMA status *
* Version 3.5 10/18/93 *
* accept DOS 6 *
* save BIOS com port addresses at $40:$0 *
* store info about MSCDEX CD-ROM drives *
***************************************************************************
* Telephone: 719-260-6641, CompuServe: 76004,2611. *
* Requires Turbo Pascal 6 or 7 to compile. *
***************************************************************************}
{$R-,S-,I-,V-,B-,F-,A-,E-,N-,G-,X-}
{$M 2048,0,20000}
{.$DEFINE Debug} {Activate for status messages}
{.$DEFINE MeasureStack} {Activate to measure stack usage}
program MarkNet;
uses
Dos,
MemU,
Xms,
Ems;
const
MarkFOpen : Boolean = False; {True while mark file is open}
Quiet : Boolean = False; {Set True to avoid screen output}
var
MarkName : PathStr; {Name of mark file}
DevicePtr : ^DeviceHeader; {Pointer to the next device header}
DeviceSegment : Word; {Current device segment}
DeviceOffset : Word; {Current device offset}
MarkF : file; {Dump file}
DosPtr : ^DosRec; {Pointer to internal DOS table}
HiMemSeg : Word;
CommandSeg : Word; {PSP segment of primary COMMAND.COM}
CommandPsp : array[1..$100] of Byte;
FileTableA : array[1..5] of SftRecPtr;
FileTableCnt : Word;
FileRecSize : Word;
EHandles : Word; {For tracking EMS allocation}
EmsPages : ^PageArray;
XHandles : Word; {For tracking XMS allocation}
XmsPages : XmsHandlesPtr;
HMAStatus : Byte;
McbG : McbGroup; {Mcbs allocated as we go resident}
CDCnt : Word; {For tracking MSCDEX information}
CDInfo : CDROMDeviceArray;
SaveExit : Pointer;
{$IFDEF MeasureStack}
I : Word;
{$ENDIF}
procedure ExitHandler; far;
{-Trap error exits (only)}
begin
ExitProc := SaveExit;
if MarkFOpen then begin
if IoResult = 0 then ;
Close(MarkF);
if IoResult = 0 then ;
Erase(MarkF);
end;
{Turbo will swap back, so undo what we've done already}
SwapVectors;
end;
procedure Abort(Msg : String);
{-Halt in case of error}
begin
WriteLn(Msg);
Halt(1);
end;
procedure FindDevChain;
{-Return segment, offset and pointer to NUL device}
begin
DosPtr := Ptr(OS(DosList).S, OS(DosList).O-2);
DevicePtr := @DosPtr^.NullDevice;
DeviceSegment := OS(DevicePtr).S;
DeviceOffset := OS(DevicePtr).O;
end;
procedure CheckWriteError;
{-Check for errors writing to mark file}
begin
if IoResult = 0 then
Exit;
Abort('Error writing to '+MarkName);
end;
procedure SaveStandardInfo;
{-Save the ID string, the vectors, and so on}
type
IDArray = array[1..4] of Char;
var
PSeg : Word;
ID : IDArray;
begin
{Write the ID string}
{$IFDEF Debug}
WriteLn('Writing mark file ID string');
{$ENDIF}
ID := NetMarkID;
BlockWrite(MarkF, ID, SizeOf(IDArray));
CheckWriteError;
{Write the start address of the device chain}
{$IFDEF Debug}
WriteLn('Writing null device address');
{$ENDIF}
BlockWrite(MarkF, DevicePtr, SizeOf(Pointer));
CheckWriteError;
{Write the vector table}
{$IFDEF Debug}
WriteLn('Writing interrupt vector table');
{$ENDIF}
BlockWrite(MarkF, Mem[0:0], 1024);
CheckWriteError;
{Write miscellaneous save areas}
{$IFDEF Debug}
WriteLn('Writing EGA save table');
{$ENDIF}
BlockWrite(MarkF, Mem[$40:$A8], 8); {EGA save table}
CheckWriteError;
{$IFDEF Debug}
WriteLn('Writing interapplications communication area');
{$ENDIF}
BlockWrite(MarkF, Mem[$40:$F0], 16); {Interapplications communication area}
CheckWriteError;
{$IFDEF Debug}
WriteLn('Writing parent PSP segment and length');
{$ENDIF}
PSeg := Mem[PrefixSeg:$16];
BlockWrite(MarkF, PSeg, 2); {Parent's PSP segment}
BlockWrite(MarkF, Mem[PSeg-1:3], 2); {Parent's PSP's length}
CheckWriteError;
{$IFDEF Debug}
WriteLn('Writing BIOS printer table');
{$ENDIF}
BlockWrite(MarkF, Mem[$40:$0], 18); {Com ports, Printer ports, Equip flag}
CheckWriteError;
{Write EMS information}
if EMSpresent then begin
if MaxAvail < 2048 then begin
WriteLn('Need 2048 bytes for EMS handle table. Have ', MaxAvail);
Abort('Insufficient memory');
end;
GetMem(EmsPages, 2048);
EHandles := EMSHandles(EmsPages^);
end else
EHandles := 0;
{$IFDEF Debug}
WriteLn('Writing EMS handle information');
{$ENDIF}
BlockWrite(MarkF, EHandles, SizeOf(Word));
if EHandles <> 0 then
BlockWrite(MarkF, EmsPages^, SizeOf(HandlePageRecord)*EHandles);
CheckWriteError;
{Write XMS information}
if XmsInstalled then begin
XHandles := GetXmsHandles(XmsPages);
HMAStatus := AllocateHma($FFFF);
if HMAStatus = 0 then
if FreeHma = 0 then ;
end else begin
XHandles := 0;
HMAStatus := $80;
end;
{$IFDEF Debug}
WriteLn('Writing XMS handle and HMA information');
{$ENDIF}
BlockWrite(MarkF, XHandles, SizeOf(Word));
if XHandles <> 0 then
BlockWrite(MarkF, XmsPages^, SizeOf(XmsHandleRecord)*XHandles);
BlockWrite(MarkF, HMAStatus, SizeOf(Byte));
CheckWriteError;
end;
procedure SaveDevChain;
{-Save the device driver chain}
begin
{$IFDEF Debug}
WriteLn('Saving device driver chain');
{$ENDIF}
while OS(DevicePtr).O <> $FFFF do begin
BlockWrite(MarkF, DevicePtr^, SizeOf(DeviceHeader));
CheckWriteError;
with DevicePtr^ do
DevicePtr := Ptr(NextHeaderSegment, NextHeaderOffset);
end;
end;
procedure BufferFileTable;
{-Save an image of the system file table}
var
S : SftRecPtr;
Size : Word;
begin
with DosPtr^ do begin
S := FirstSFT;
FileTableCnt := 0;
while OS(S).O <> $FFFF do begin
Inc(FileTableCnt);
Size := 6+S^.Count*FileRecSize;
if MaxAvail < Size then begin
WriteLn('Need ', Size, ' bytes for system file table. Have ', MaxAvail);
Abort('Insufficient memory');
end;
GetMem(FileTableA[FileTableCnt], Size);
Move(S^, FileTableA[FileTableCnt]^, Size);
S := S^.Next;
end;
end;
end;
procedure BufferAllocatedMcbs;
{-Save an array of all allocated Mcbs}
var
M : McbPtr;
procedure AddMcbs;
var
Done : Boolean;
begin
repeat
inc(McbG.Count);
with McbG.Mcbs[McbG.Count] do begin
mcb := OS(M).S;
psp := M^.Psp;
end;
Done := (M^.Id = 'Z');
M := Ptr(OS(M).S+M^.Len+1, 0);
until Done;
end;
begin
McbG.Count := 0;
M := Mcb1;
AddMcbs;
if HiMemSeg <> 0 then begin
M := Ptr(HiMemSeg, 0);
AddMcbs;
end;
end;
procedure SaveDOSTable;
{-Save the DOS internal variables table}
var
DosBase : Pointer;
Size : Word;
begin
{$IFDEF Debug}
WriteLn('Saving DOS data area at 0050:0000');
{$ENDIF}
BlockWrite(MarkF, mem[$50:$0], $200);
CheckWriteError;
DosBase := Ptr(OS(DosPtr).S, 0);
Size := OS(DosPtr^.FirstSFT).O;
{$IFDEF Debug}
WriteLn('Saving DOS variables table at ', HexPtr(DosBase));
{$ENDIF}
BlockWrite(MarkF, Size, SizeOf(Word));
BlockWrite(MarkF, DosBase^, Size);
CheckWriteError;
end;
procedure SaveFileTable;
{-Save the state of the file table}
var
I : Word;
Size : Word;
begin
{$IFDEF Debug}
WriteLn('Saving DOS file table at ', HexPtr(DosPtr^.FirstSFT));
{$ENDIF}
BlockWrite(MarkF, FileTableCnt, SizeOf(Word));
for I := 1 to FileTableCnt do begin
Size := 6+FileTableA[I]^.Count*FileRecSize;
BlockWrite(MarkF, FileTableA[I]^, Size);
end;
CheckWriteError;
end;
procedure BufferCommandPSP;
{-Save the PSP of COMMAND.COM}
var
PspPtr : Pointer;
begin
CommandSeg := MasterCommandSeg(HiMemSeg);
PspPtr := Ptr(CommandSeg, 0);
Move(PspPtr^, CommandPsp, $100);
end;
procedure SaveCommandPSP;
begin
{$IFDEF Debug}
WriteLn('Saving COMMAND.COM PSP at ', HexW(CommandSeg), ':0000');
{$ENDIF}
BlockWrite(MarkF, CommandPsp, $100);
CheckWriteError;
end;
procedure SaveCommandPatch;
{-Save the patch that NetWare applies to command.com}
label
ExitPoint;
const
Patch : array[0..14] of Char = ':/'#0'_______.___'#0;
var
Segm : Word;
Ofst : Word;
Indx : Word;
begin
(*
for Segm := CommandSeg to PrefixSeg do
for Ofst := 0 to 15 do begin
Indx := 0;
while (Indx <= 14) and (Patch[Indx] = Char(Mem[Segm:Ofst+Indx])) do
Inc(Indx);
if Indx > 14 then begin
{$IFDEF Debug}
WriteLn('Saving COMMAND patch address at ', HexW(Segm), ':', HexW(Ofst));
{$ENDIF}
goto ExitPoint;
end;
end;
*)
Segm := 0;
Ofst := 0;
ExitPoint:
BlockWrite(MarkF, Ofst, SizeOf(Word));
BlockWrite(MarkF, Segm, SizeOf(Word));
CheckWriteError;
end;
procedure FindEnv(CommandSeg : Word; var EnvSeg, EnvLen : Word);
{-Return the segment and length of the master environment}
var
Mcb : Word;
begin
Mcb := CommandSeg-1;
EnvSeg := MemW[CommandSeg:$2C];
if EnvSeg = 0 then
{Master environment is next block past COMMAND}
EnvSeg := Commandseg+MemW[Mcb:3]+1;
EnvLen := MemW[(EnvSeg-1):3] shl 4;
end;
procedure SaveDosEnvironment;
{-Save the master copy of the DOS environment}
var
EnvSeg : Word;
EnvLen : Word;
P : Pointer;
begin
FindEnv(CommandSeg, EnvSeg, EnvLen);
{$IFDEF Debug}
WriteLn('Saving master environment, ', EnvLen, ' bytes at ', HexW(EnvSeg), ':0000');
{$ENDIF}
P := Ptr(EnvSeg, 0);
BlockWrite(MarkF, EnvLen, SizeOf(Word));
BlockWrite(MarkF, P^, EnvLen);
CheckWriteError;
end;
procedure SaveCommState;
{-Save the state of the communications controllers}
var
PicMask : Byte;
Com : Byte;
LCRSave : Byte;
Base : Word;
ComPortBase : array[1..2] of Word absolute $40:0; {Com port base addresses}
procedure SaveReg(Offset : Byte);
{-Save one communications register}
var
Reg : Byte;
begin
Reg := Port[Base+Offset];
BlockWrite(MarkF, Reg, SizeOf(Byte));
CheckWriteError;
end;
begin
{$IFDEF Debug}
WriteLn('Saving communications environment');
{$ENDIF}
{Save the 8259 interrupt enable mask}
PicMask := Port[$21];
BlockWrite(MarkF, PicMask, SizeOf(Byte));
CheckWriteError;
for Com := 1 to 2 do begin
Base := ComPortBase[Com];
{Save the Com port base address}
BlockWrite(MarkF, Base, SizeOf(Word));
CheckWriteError;
if Base <> 0 then begin
{Save the rest of the control state}
SaveReg(IER); {Interrupt enable register}
SaveReg(LCR); {Line control register}
SaveReg(MCR); {Modem control register}
LCRSave := Port[Base+LCR]; {Save line control register}
Port[Base+LCR] := LCRSave or $80; {Enable baud rate divisor registers}
SaveReg(BRL); {Baud rate divisor low}
SaveReg(BRH); {Baud rate divisor high}
Port[Base+LCR] := LCRSave; {Restore line control register}
end;
end;
end;
procedure SaveCDRoms;
{-Save list of CD-ROM devices}
begin
{$IFDEF Debug}
WriteLn('Saving CD-ROM information');
{$ENDIF}
CDCnt := GetCDCount(CDInfo);
BlockWrite(MarkF, CDCnt, SizeOf(Word));
CheckWriteError;
if CDCnt <> 0 then begin
BlockWrite(MarkF, CDInfo, CDCnt*SizeOf(CDROMDeviceRec));
CheckWriteError;
end;
end;
procedure SaveAllocatedMcbs;
{-Save list of allocated memory control blocks}
begin
{$IFDEF Debug}
WriteLn('Saving memory allocation group');
{$ENDIF}
{Save the number of Mcbs}
BlockWrite(MarkF, McbG.Count, SizeOf(Word));
CheckWriteError;
{Save the used Mcbs}
BlockWrite(MarkF, McbG.Mcbs, 2*SizeOf(Word)*McbG.Count);
CheckWriteError;
end;
function CompaqDOS30 : Boolean; assembler;
{-Return true if Compaq DOS 3.0}
asm
mov ah,$34
int $21
cmp bx,$019C
mov al,1
jz @Done
dec al
@Done:
end;
procedure ValidateDosVersion;
{-Assure supported version of DOS and compute size of DOS internal filerec}
var
DosVer : Word;
begin
DosVer := DosVersion;
case Hi(DosVer) of
3 : if (Hi(DosVer) < $0A) and not CompaqDOS30 then
{IBM DOS 3.0}
FileRecSize := 56
else
{DOS 3.1+ or Compaq DOS 3.0}
FileRecSize := 53;
4, 5, 6 : FileRecSize := 59;
else
Abort('Requires DOS 3 - 6');
end;
end;
procedure SaveIDStrings;
{-Save identification strings within the PSP}
var
ID : String[10];
begin
Move(MarkName, Mem[PrefixSeg:$80], Length(MarkName)+1);
Mem[PrefixSeg:$80+Length(MarkName)+1] := 13;
ID := NmarkID;
Move(ID[1], Mem[PrefixSeg:NmarkOffset], Length(ID));
end;
procedure CloseStandardFiles;
{-Close all standard files}
var
H : Word;
begin
for H := 0 to 4 do
asm
mov ah,$3E
mov bx,H
int $21
end;
end;
procedure GetOptions;
{-Get command line options}
var
Arg : String[127];
procedure UnknownOption;
begin
WriteLn('Unknown command line option: ', Arg);
Halt(1);
end;
procedure BadOption;
begin
WriteLn('Invalid command line option: ', Arg);
Halt(1);
end;
procedure WriteCopyright;
begin
WriteLn('MARKNET ', Version, ', Copyright 1993 TurboPower Software');
end;
procedure WriteHelp;
begin
WriteCopyright;
WriteLn;
WriteLn('MARKNET saves a picture of the PC system status in a file,');
WriteLn('so that the state can later be restored by using RELNET.');
WriteLn;
WriteLn('MARKNET accepts the following command line syntax:');
WriteLn;
WriteLn(' MARKNET [Options] MarkFile');
WriteLn;
WriteLn('Options may be preceded by either / or -. Valid options are as follows:');
WriteLn(' /Q write no screen output.');
WriteLn(' /? write this help screen.');
Halt(1);
end;
procedure GetArgs(S : String);
var
SPos : Word;
begin
SPos := 1;
repeat
Arg := NextArg(S, SPos);
if Arg = '' then
Exit;
if Arg = '?' then
WriteHelp
else
case Arg[1] of
'-', '/' :
case Length(Arg) of
1 : BadOption;
2 : case Upcase(Arg[2]) of
'?' : WriteHelp;
'Q' : Quiet := True;
else
BadOption;
end;
else
UnknownOption;
end;
else
if Length(MarkName) <> 0 then
BadOption
else
MarkName := StUpcase(Arg);
end;
until False;
end;
begin
MarkName := '';
{Get arguments from the command line and the environment}
GetArgs(StringPtr(Ptr(PrefixSeg, $80))^);
GetArgs(GetEnv('MARKNET'));
{Assure mark file specified}
if Length(MarkName) = 0 then
WriteHelp;
if not Quiet then
WriteCopyright;
end;
begin
{$IFDEF MeasureStack}
fillchar(mem[sseg:0], sptr-16, $AA);
{$ENDIF}
{Must run with standard DOS vectors}
SwapVectors;
SaveExit := ExitProc;
ExitProc := @ExitHandler;
{Get command line options}
GetOptions;
{Assure supported version of DOS}
ValidateDosVersion;
{Find the device driver chain and the DOS internal table}
FindDevChain;
{Find first block of high memory}
HiMemSeg := FindHiMemStart;
{Save PSP region of COMMAND.COM}
BufferCommandPSP;
{Buffer the DOS file table}
BufferFileTable;
{Deallocate environment}
asm
mov es,PrefixSeg
mov es,es:[$002C]
mov ah,$49
int $21
end;
{Buffer the allocated mcb array}
BufferAllocatedMcbs;
{Open the mark file}
Assign(MarkF, MarkName);
Rewrite(MarkF, 1);
if IoResult <> 0 then
Abort('Error creating '+MarkName);
MarkFOpen := True;
{Save ID string, interrupt vectors and other standard state information}
SaveStandardInfo;
{Save the device driver chain}
SaveDevChain;
{Save the DOS internal variables table}
SaveDOSTable;
{Save the DOS internal file management table}
SaveFileTable;
{Save the PSP of COMMAND.COM}
SaveCommandPSP;
{Save the location that NetWare may patch in COMMAND.COM}
SaveCommandPatch;
{Save the master copy of the DOS environment}
SaveDosEnvironment;
{Save the state of the communications controllers}
SaveCommState;
{Save list of CD-ROM devices}
SaveCDRoms;
{Save list of allocated memory control blocks}
SaveAllocatedMcbs;
{Close mark file}
Close(MarkF);
CheckWriteError;
{Move ID strings into place}
SaveIDStrings;
if not Quiet then
WriteLn('Stored mark information in ', MarkName);
{$IFDEF MeasureStack}
I := 0;
while I < SPtr-16 do
if mem[sseg:i] <> $AA then begin
writeln('unused stack ', i, ' bytes');
I := SPtr;
end else
inc(I);
{$ENDIF}
Flush(Output);
{Close file handles}
CloseStandardFiles;
{Go resident}
asm
mov dl,byte ptr markname
xor dh,dh
add dx,$0090
mov cl,4
shr dx,cl
mov ax,$3100
int $21
end;
end.